home *** CD-ROM | disk | FTP | other *** search
/ PC go! 2008 April / PCgo 2008-04 (DVD).iso / interface / contents / demoversionen_3846 / 13664 / files / Data1.cab / vertextie.cls < prev    next >
Encoding:
Visual Basic class definition  |  2001-10-16  |  6.7 KB  |  225 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "clsVertexTie"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. '/******************************************************************/
  15. '/*                                                                */
  16. '/*                      TurboCAD for Windows                      */
  17. '/*                   Copyright (c) 1993 - 2001                    */
  18. '/*             International Microcomputer Software, Inc.         */
  19. '/*                            (IMSI)                              */
  20. '/*                      All rights reserved.                      */
  21. '/*                                                                */
  22. '/******************************************************************/
  23.  
  24. Option Explicit
  25.  
  26. Implements ITurboCADSmartTieServer
  27.  
  28. Public Type VertexTieData
  29.     idVrtSbj As Long
  30.     idVrtSbd As Long
  31. End Type
  32.  
  33. Private idVTie As String
  34.  
  35. Private gxTSets As TieSets
  36. Private gxTSet  As TieSet
  37. Private gxTie   As Tie
  38. Private gxDwg   As Drawing
  39. Private tieData As VertexTieData
  40.     
  41. Private gxVrtsSbj As Vertices
  42. Private gxVrtsSbd As Vertices
  43.  
  44. Private gxGrs   As Graphics
  45. Private gxGrSbj As Graphic
  46. Private gxGrSbd As Graphic
  47.  
  48. Private Function Clear()
  49.     
  50.     Set gxVrtsSbj = Nothing
  51.     Set gxVrtsSbd = Nothing
  52.     
  53.     Set gxGrSbj = Nothing
  54.     Set gxGrSbd = Nothing
  55.     Set gxGrs = Nothing
  56.     Set gxTie = Nothing
  57.     Set gxTSet = Nothing
  58.     Set gxTSets = Nothing
  59.     Set gxDwg = Nothing
  60.  
  61. End Function
  62.  
  63.  
  64. Private Function ITurboCADSmartTieServer_AddTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, ByVal lType As Long) As Boolean
  65.     
  66.     Dim varData As Variant
  67.     Set gxDwg = pIDispDwg
  68.     
  69.     Set gxTSets = gxDwg.TieSets
  70.     Set gxTSet = gxTSets.TieSet(idSbj, idSbd)
  71.     If (gxTSet.Count = 0) Then
  72.         tieData.idVrtSbj = lType
  73.         tieData.idVrtSbd = -1
  74.         varData = tieData
  75.         gxTSet.AddTie idVTie, 1, varData
  76.     Else
  77.         Set gxTie = gxTSet(0)
  78.         varData = gxTie.Data
  79.         tieData = varData(0)
  80.         tieData.idVrtSbd = lType
  81.         varData = tieData
  82.         gxTie.Data = tieData
  83.     End If
  84.     
  85.     
  86.     Set gxTSet = gxTSets.TieSet(idSbd, idSbj)
  87.     If (gxTSet.Count = 0) Then
  88.         tieData.idVrtSbj = -1
  89.         tieData.idVrtSbd = lType
  90.         varData = tieData
  91.         gxTSet.AddTie idVTie, 1, varData
  92.     Else
  93.         Set gxTie = gxTSet(0)
  94.         varData = gxTie.Data
  95.         tieData = varData(0)
  96.         tieData.idVrtSbj = lType
  97.         varData = tieData
  98.         gxTie.Data = tieData
  99.     End If
  100.     
  101.     UpdateTie gxTSet
  102.     ITurboCADSmartTieServer_AddTie = True
  103.     Clear
  104.  
  105. End Function
  106.  
  107. Private Function ITurboCADSmartTieServer_CopyTie(ByVal pIDispDwg As Object, ByVal idSbjSrc As Long, ByVal idSbdSrc As Long, ByVal idSbjTrg As Long, ByVal idSbdTrg As Long) As Boolean
  108.     
  109.     Set gxDwg = pIDispDwg
  110.     Set gxGrs = gxDwg.Graphics
  111.     Set gxGrSbj = gxGrs.GraphicFromID(idSbjTrg)
  112.     Set gxGrSbd = gxGrs.GraphicFromID(idSbdTrg)
  113.     
  114.     Set gxTSets = gxDwg.TieSets
  115.     Set gxTSet = gxTSets.TieSet(idSbjSrc, idSbdSrc)
  116.     Set gxTie = gxTSet(0)
  117.     tieData = gxTie.Data
  118.     
  119.     Set gxTSet = gxTSets.Add(idVTie, gxGrSbj, gxGrSbd, tieData.idVrtSbj, 0)
  120.     
  121.     Set gxTie = gxTSet(0)
  122.     gxTie.Data = tieData
  123.     
  124.     Clear
  125.  
  126.     ITurboCADSmartTieServer_CopyTie = True
  127. End Function
  128.  
  129. Private Function ITurboCADSmartTieServer_DeleteTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, ByVal pIDsipGr As Object) As Boolean
  130.     ITurboCADSmartTieServer_DeleteTie = True
  131. End Function
  132.  
  133. Private Property Get ITurboCADSmartTieServer_Description() As String
  134.     ITurboCADSmartTieServer_Description = "Vertex tie"
  135. End Property
  136.  
  137. Private Function ITurboCADSmartTieServer_GetIDs(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Variant
  138. ' It is not need to do something here because this method doesn't use Graphic's DataBase ID
  139. End Function
  140.  
  141. Private Function ITurboCADSmartTieServer_GetTypesInfo(Names As Variant, Types As Variant) As Long
  142.     ITurboCADSmartTieServer_GetTypesInfo = 0
  143. End Function
  144.  
  145. Private Function ITurboCADSmartTieServer_Initialize(ByVal ThisTieMethod As Object) As Boolean
  146.     Dim gxTMethod As TieMethod
  147.     Set gxTMethod = ThisTieMethod
  148.     idVTie = gxTMethod.Name
  149.     ITurboCADSmartTieServer_Initialize = True
  150. End Function
  151.  
  152. Private Function UpdateTie(ByRef gxTSet As TieSet)
  153.  
  154.     Dim gxVrtSbj As Vertex
  155.     Dim gxVrtSbd As Vertex
  156.     Dim varData As Variant
  157.     Dim gxGrSbdNew As Graphic
  158.     
  159.     Dim gxDwg As Drawing
  160.     Dim hDwg As Long
  161.     Dim hGrSbd As Long
  162.     Dim idSbd As Long
  163.     
  164.     Set gxTie = gxTSet(0)
  165.     
  166.     varData = gxTie.Data
  167.     tieData = varData(0)
  168.     
  169.     If (tieData.idVrtSbd <> -1 And tieData.idVrtSbj <> -1) Then
  170.         
  171.             Set gxGrSbj = gxTSet.Subject
  172.             Set gxGrSbd = gxTSet.Subordinate
  173.  
  174.             Set gxVrtsSbj = gxGrSbj.Vertices
  175.             Set gxVrtsSbd = gxGrSbd.Vertices
  176.             
  177.             gxVrtsSbj.UseWorldCS = True
  178.             gxVrtsSbd.UseWorldCS = True
  179.             
  180.             Set gxVrtSbj = gxVrtsSbj(tieData.idVrtSbj)
  181.             Set gxVrtSbd = gxVrtsSbd(tieData.idVrtSbd)
  182.             
  183.             gxGrSbd.Deleted = True
  184.             gxGrSbd.Draw
  185.             gxGrSbd.Deleted = False
  186.             
  187.             gxVrtSbd.X = gxVrtSbj.X
  188.             gxVrtSbd.Y = gxVrtSbj.Y
  189.             gxVrtSbd.Z = gxVrtSbj.Z
  190.             
  191.             gxGrSbd.Draw
  192.             
  193.             Set gxVrtSbd = Nothing
  194.             Set gxVrtSbj = Nothing
  195.             Set gxGrSbj = Nothing
  196.             Set gxGrSbd = Nothing
  197.        
  198.    
  199.     End If
  200.     
  201. End Function
  202.  
  203. Private Sub ITurboCADSmartTieServer_SetIDs(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, pvarIDs As Variant)
  204. ' It is not need to do something here because this method doesn't use Graphic's DataBase ID
  205. End Sub
  206.  
  207. Private Function ITurboCADSmartTieServer_TieCanNODEED(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Boolean
  208.     ITurboCADSmartTieServer_TieCanNODEED = True
  209. End Function
  210.  
  211. Private Function ITurboCADSmartTieServer_UpdateTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Integer
  212.     
  213.     Set gxDwg = pIDispDwg
  214.     
  215.     Set gxTSets = gxDwg.TieSets
  216.     
  217.     Set gxTSet = gxTSets.TieSet(idSbj, idSbd)
  218.     
  219.     UpdateTie gxTSet
  220.  
  221.     ITurboCADSmartTieServer_UpdateTie = 0
  222.     Clear
  223.  
  224. End Function
  225.